package Coriander::Window {
use strict;
use warnings;
use Coriander::Debug;
our @ISA = qw(Coriander::WindowWithEvents MainWindow);


# This is the base class of all windows you'll see in Coriander.
# Basically it's just a wrapper around Tk, because I'm lazy
# and wanted to make some things easier for myself.

our %window = ();
our @taskQueue = ();

    
use overload (
    fallback=> 1,
    '""'    => sub { $_[0]->isa("Tk") ? $_[0]->PathName : "???" }
);

# $window = Coriander::Window::SomeWindowClass->new();      # Creates a new Tk window of the specified subclass and shows it.
# $window = $otherWindow->new();                            # Creates a new Tk window of the same class as $otherWindow.

sub new {
    my $class = shift;
    DEBUGSTART "New $class";
    if (my $proto = ref $class) { DEBUG "Cloning a $proto window"; return $proto->new(@_); }
    my $self = $class->_create();
    
    DEBUGDONE "$self: window created.";
    return $self;
    
}
    
# An internal placeholder method.
# The actual methods are defined in Coriander::Window::MainWindow::_create and Coriander::Window::Toplevel::_create,
# near the bottom of this file.
sub _create {
    my $class = shift;
    die "Window classes must be a subclass of Coriander::Window::MainWindow or Coriander::Window::Toplevel";
}

# An internal method that tells a window object to set itself brings the window to the front, and tells the window it's done initializing it.
# Calls two methods on the window object:
# $window->windowLoad(), in which the window is given the chance to create widgets, set up bindings, and that sort of initial stuff,
# and $window->windowShow(), in which the window can take care of final logic, such as bringing up other windows if that needs to happen.
sub _init {
    my $self = shift;

    DEBUGSTART "$self: initializing";
    DEBUGSTART "Calling windowLoad()";
    $self->OnDestroy( sub { $self->windowDestroy } );
    $self->protocol( WM_DELETE_WINDOW => sub { $self->windowClose } );
    $self->windowLoad();
    DEBUGDONE "$self: windowLoad() finished.";
                            
    DEBUGDONE "$self initialized.";
    $self->deiconify;
    
    $self->enqueue( sub {
        DEBUGSTART "$self: calling windowShow()";
        $self->windowShow;
        $self->raise;
        $self->focus;
        $self->deiconify;
        DEBUGDONE "$self: windowShow() finished.";
    });
    print $@ if $@;
}    

# $tl = $window->open( 'Some::Other::WindowClass' );
# Creates a Toplevel window which will be a child of $window.
# Basically this is a wrapper around $window->Toplevel(), with the additional benefits that
# $tl->setup() and $tl->done() will be called, and $tl will have access to all the methods
# provided in Coriander::Window if its clas has set its @ISA set properly, including at least Coriander::Window::Toplevel.
sub open {
    my $self = shift;
    my $winclass = shift;

    DEBUGSTART "$self opening new $winclass";
    my $childwin = $winclass->_create($self);
    DEBUGDONE "$childwin opened.";

    
    return $childwin;
}

# $tl = $window->show( 'Some::Other::WindowClass' );
# Acts just like $window->open(), but if ->show() has been called for this subclass before and the window
# created in that call still exists, that window will be shown instead of creating a new one.
sub show {
    my $self = shift;
    my $winclass = ref( ($_[0]||$self) ) || ($_[0]||$self);
    
    DEBUGSTART "$self showing $winclass";
    if (not exists $window{$winclass}) {
        $window{$winclass} = $self->open($winclass);
        
        DEBUG "$window{$winclass}: OnDestroy set for window reference cleanup";
        $window{$winclass}->OnDestroy( sub { DEBUG "$window{$winclass} reference cleanup."; delete $window{$winclass} } );
    } else {
    
        DEBUG "$window{$winclass}: deiconify, raise, focus.";
        $window{$winclass}->deiconify;
        $window{$winclass}->windowShow;
    }

    DEBUGDONE "Showing $window{$winclass}, window retrieved.";
    
    return $window{$winclass};
}

# $window->center();                    # Centers the window relative to the screen
# $window->center($window->parent)      # Centers the window relative to its parent, so that dialog windows show up in the middle of their parent windows.
sub center {
    my $self = shift;
    my $parent = shift;
    
    DEBUG "$self: center() request delayed.";
    
    $self->enqueue( sub {
        #$self->update;
        
        DEBUGSTART "$self: centering";
     
        my %parentGeo = (
            top => 0,
            left => 0,
            width => $self->screenwidth,
            height => $self->screenheight
        );
      
        if ($parent) {
           DEBUG "Using $parent as reference.";
           my ($w, $h, $l, $t) = $parent->geometry =~ m/(\d+)x(\d+)\+(-?\d+)\+(-?\d+)/;
           $parentGeo{top} = $parent->state() eq "zoomed" ? 0 : $t;
           $parentGeo{left} = $parent->state() eq "zoomed" ? 0 : $l;
           $parentGeo{width} = $w;
           $parentGeo{height} = $h;
        }
        
        my $top = $parentGeo{top}   + ( int($parentGeo{height}/2) - int($self->height/2) );
        my $left = $parentGeo{left} + ( int($parentGeo{width} /2) - int($self->width /2) );
        
        my $geo = sprintf("%sx%s+%s+%s",
            $self->width,
            $self->height,
            $left,
            $top,
        );
        DEBUG "Centering: $geo";
        $self->geometry($geo);
        DEBUGDONE "Centered.";
    });
}

# $window->localWindow( \&coderef );
# A wrapper around Tk's own ->Walk() method, limiting itself only to widgets that are on this window, not those on its child toplevels.
sub localWalk {
    my $self = shift;
    my $coderef = shift;
    $self->Walk( sub{
        return if $_[0]->toplevel ne $self;
        $coderef->($_[0]);
    });
}

# my $widget = $window->localWidget( $name );
# A wrapper around Tk's own ->Widget() method, giving you easier access to widgets on this window.
# Returns the first widget on this window what has the given name - so be careful if you use this method
# and have widgets with identical names (but different paths), because localWidget() might fight the wrong one.
sub localWidget {
    my $self = shift;
    my $name = shift;
    my $widget;
    $self->localWalk( sub { if ($_[0]->name eq $name) { $widget = $_[0]; return} } );
    return $widget;
}

# my ($widget1, $widget2, ..., $widgetN) = $window->localWidgets($name1, $name2, $nameN);
# Like localWidget above, but lets you get more than one widget at once.
sub localWidgets {
    my $self = shift;
    my @widgets = ();
    while (my $name = shift) {
        push @widgets, $self->localWidget($name);
    }
    return @widgets;
}
                 
# $window->enqueue( sub { ... } );
# A wrapper around Tk's own "after" mechanism, because at one point that didn't work the way I wanted it to.
# Right now I'm not too sure if I still need enqueue() or could just switch back to Tk's own mechanism.
# Let me make a note of that.
# TODO: Is enqueue() still needed or will Tk's own after() or afterIdle() do the job now?   
sub enqueue {
    my $self = shift;
    my $task = shift;
    push @taskQueue, $task;
    $self->DoWhenIdle( sub{
        $self->idletasks;
        my $task = shift @taskQueue;
        $task->();
    });
}

}1;

package Coriander::Window::MainWindow {
use strict;
use warnings;
use Coriander::Debug;
our @ISA = qw(Coriander::Window);

# A Coriander::Window subclass, meant to be the base class for windows which are intended to be MainWindows.

# An internal method to create the actual window. It 'bless'es the window to its class, so that methods defined
# in that class as well as its superclasses are accessable.
sub _create {
    my $name = ref($_[0]) || $_[0];
    DEBUG "$name: creating as MainWindow.";
    my $win =  MainWindow->new();
    bless $win, $_[0];
    
    $win->_init();
    
    return $win;
}
}1;

package Coriander::Window::Toplevel {
use strict;
use warnings;
use Coriander::Debug;
our @ISA = qw(Coriander::Window);

# A Coriander::Window subclass, meant to be the base class for windows which are intended to be Toplevels.

# $tl = Some::Other::WindowClass->new( $parentWindow );         # Creates the Toplevel window as a child of $parentWindow
# $tl = $otherToplevelWindow->new();                            # Clones $otherToplevelWindow into a child of itself.
sub new {
    my $parent = shift;
    if (ref $parent) {
        DEBUGSTART "$parent opening a clone of itself";
        my $clone = $parent->open(ref $parent);
        DEBUGDONE "$parent: new clone is $clone.";
    } else {
        die "Use \$win->open('$parent') to create new Coriander::Window::Toplevel instances";
    }
}

# An internal method to create the actual window. It 'bless'es the window to its class, so that methods defined
# in that class as well as its superclasses are accessable.
sub _create {   
    my $name = ref($_[0]) || $_[0];
    my $parent = $_[1];
    DEBUG "$name: creating as Toplevel.";
    $name =~ s/^.+:://;
    $name = "win$name";
    my $win = $parent->Toplevel(Name => $name);
    bless $win, $_[0];
    $win->_init();
    
    return $win;
}

}1;

    
package Coriander::WindowWithEvents {
use strict;
use warnings;
use Coriander::Debug;

sub windowLoad {
        my $win = shift;
        DEBUG "$win has default windowLoad handler.";
}

sub windowShow {
        my $win = shift;
        DEBUG "$win has default windowShow handler.";
}

sub windowClose {
        my $win = shift;
        DEBUG "$win has default windowClose handler. Destroying window.";
        $win->destroy;
}

sub windowDestroy {
        my $win = shift;
        DEBUG "$win has default windowDestroy handler.";
}

# $window->buttonHandlers();
# Set -command handlers for all buttons on $window that don't have a -command handler set yet.
# buttonHandlers will search for the following methods in $window's class and set the first one it finds as the
# -command hander. In this list, <Name> is the widget's name, <RelPathName> s the widget's pathname relative to $window, and <PathName> is widget's fully qualified pathname. Both <RelPathName> and <PathName> don't have an initial dot, and all other dots are converted to underscores.
#       METHOD                  EXAMPLE (.toplevel.frame3.button2)
#   * <Name>Click               button2Click
#   * <Name>_Click              button2_Click
#   * <RelPathName>_Click       frame3_button2_Click
#   * <PathName>_Click          toplevel_frame3_button2_Clicks

# The subroutine will receive two arguments:
# $_[0] will be $window (as the subroutine /is/ a method on the window's class after all)
# $_[1] will be the button itself, for convenience.
sub buttonHandlers {
    my $self = shift;
    DEBUGSTART "$self: setting button handlers.";
    $self->localWalk( sub {
        my $w = $_[0];
        if ($w->Class eq "Button" && not defined +($w->configure("-command"))[4] ) {
            my $name = $w->name;
            my $relPath = $w->PathName;     $relPath =~ s/^$self\.?//;
            my $path = $w->PathName;        $path =~ s/^\.//;
            my @method = ("${name}Click", "${name}_Click", "${relPath}_Click", "${path}_Click");
            
            while (my $method = shift @method) {
                if ($self->can($method)) {
                    DEBUG "$relPath: $method";
                    $w->configure(-command => sub {$self->$method($w)});
                    return;
                }
            }
            DEBUG "$relPath: no handler found.";
        }
    });
    DEBUGDONE "$self: button handlers set.";
}
}1;